home *** CD-ROM | disk | FTP | other *** search
Text File | 1998-10-26 | 5.7 KB | 158 lines | [TEXT/ScoM] |
- (def-neuron rules
-
- ;;;; Level1 rules
-
- (and (in 1 '=) (in 2 '=) (all-in 3 '(a c) -10 10))
- (transpose-symbol 'b trpos)
- (and (in 1 '=) (in 2 '=) (all-in 3 '(c a) -10 10))
- (transpose-symbol 'b trpos)
- (and (in 1 '=) (in 2 '=) (all-in 3 '(a a) -10 10))
- (transpose-symbol (pick-random '(a b -b =)) trpos)
- (and (in 1 '=) (in 2 '=) (all-in 3 '(a b) -10 10))
- (transpose-symbol (pick-random '(c d)) trpos)
- (and (in 1 '=) (in 2 '=) (all-in 3 '(b a) -10 10))
- (transpose-symbol (pick-random '(-b -c)) trpos)
- (and (in 1 '=) (in 2 '=) (in 3 '=))
- (transpose-symbol (in 3 0 -1) 1)
-
- ;;;; Level2 rules
-
- (and (in 1 '=) (all-in-parallel '(2 3) '((a) (a)) down2 up2))
- (transpose-symbol (pick-random '(-b b =)) trpos)
- (and (in 1 '=) (all-in-parallel '(2 3) '((a) (b)) down2 up2))
- (transpose-symbol '-b trpos)
- (and (in 1 '=) (all-in-parallel '(2 3) '((a) (c)) down2 up2))
- (transpose-symbol 'b trpos)
- (and (in 1 '=) (all-in-parallel '(2 3) '((a) (=)) down2 up2))
- (transpose-symbol (pick-random '(= -b b)) trpos)
- (and (in 1 '=) (all-in-parallel '(2 3) '((b) (a)) down2 up2))
- (transpose-symbol 'c trpos)
- (and (in 1 '=) (all-in-parallel '(2 3) '((c) (a)) down2 up2))
- (transpose-symbol 'b trpos)
- (and (in 1 '=) (all-in-parallel '(2 3) '((=) (a)) down2 up2))
- (transpose-symbol (pick-random '(= -b b)) trpos)
- (and (in 1 '=) (all-in-parallel '(2 3) '((=) (=)) down2 up2))
- (transpose-symbol (in 1 -1) -1)
-
- ;;;; Level3 rules
-
- (all-in-parallel '(1 2 3) '((a) (a) (a)) down3 up3)
- (transpose-symbol (pick-random '(c -b =)) trpos)
- (all-in-parallel '(1 2 3) '((a) (b) (a)) down3 up3)
- (transpose-symbol (pick-random '(-b =)) trpos)
- (all-in-parallel '(1 2 3) '((a) (b) (b)) down3 up3)
- (transpose-symbol (pick-random '(c -b)) trpos)
- (all-in-parallel '(1 2 3) '((b) (a) (a)) down3 up3)
- (transpose-symbol (pick-random '(c -b)) trpos)
- (all-in-parallel '(1 2 3) '((b) (a) (b)) down3 up3)
- (transpose-symbol (pick-random '(c =)) trpos)
- (all-in-parallel '(1 2 3) '((b) (a) (a)) down3 up3)
- (transpose-symbol (pick-random '(-b =)) trpos)
- (all-in-parallel '(1 2 3) '((a) (a) (c)) down3 up3)
- (transpose-symbol (pick-random '(b -b)) trpos)
- (all-in-parallel '(1 2 3) '((a) (c) (a)) down3 up3)
- (transpose-symbol (pick-random '(b -b =)) trpos)
- (all-in-parallel '(1 2 3) '((a) (c) (c)) down3 up3)
- (transpose-symbol (pick-random '(b -b)) trpos)
- (all-in-parallel '(1 2 3) '((c) (a) (a)) down3 up3)
- (transpose-symbol (pick-random '(b -b =)) trpos)
- (all-in-parallel '(1 2 3) '((c) (a) (c)) down3 up3)
- (transpose-symbol (pick-random '(b -b)) trpos)
- (all-in-parallel '(1 2 3) '((c) (c) (a)) down3 up3)
- (transpose-symbol (pick-random '(b -b =)) trpos)
- (all-in-parallel '(1 2 3) '((a) (a) (=)) down3 up3)
- (transpose-symbol (pick-random '(b c -b -c)) trpos)
- (all-in-parallel '(1 2 3) '((a) (=) (a)) down3 up3)
- (transpose-symbol (pick-random '(b c -b -c)) trpos)
- (all-in-parallel '(1 2 3) '((a) (=) (=)) down3 up3)
- (transpose-symbol (pick-random '(b c -b -c)) trpos)
- (all-in-parallel '(1 2 3) '((=) (a) (=)) down3 up3)
- (transpose-symbol (pick-random '(b c -b -c)) trpos)
- (all-in-parallel '(1 2 3) '((=) (=) (=)) down3 up3)
- (transpose-symbol (pick-random '(a b c -b -c)) trpos)
-
- ;;;; otherwise for levels
-
- (otherwise (cond ((and (in 1 '=) (in 2 '=)) ; level1
- (transpose-symbol (in 3 0) 1))
- ((in 1 '=) (pick-random '(a b -b))) ; level2
- (t (pick-random '(a b -b))))) ; level3
-
- )
-
- (setq theme '(a b c d e f e d c b c d c b a h g h f e d h g h e d c h g h d e))
-
- (setq down3 -10)
- (setq up3 10)
- (setq down2 -10)
- (setq up2 10)
-
- (setq fugue-streams (flatten (append theme (feedback-neuron 'rules 16 (list nil nil (symbol-scale '(a e) theme))))))
-
- (setq line1 (symbol-scale '(a h) fugue-streams))
- (setq line2 (symbol-shift 32 (symbol-transpose 11 (symbol-scale '(a h) fugue-streams))))
- (setq line3 (symbol-shift 64 (symbol-transpose -5 (symbol-scale '(a h) fugue-streams))))
- ;(setq line4 (symbol-shift 27 (symbol-transpose 30 (symbol-scale '(a h) fugue-streams))))
-
- (defun symbol-to-mapped-integer (s maptable)
- (if (equal s '=)
- 0
- (let ((note (symbols-to-notes s maptable)))
- (apply #'note-to-abs note))))
-
- (setq new-mater (filter-harmonize3
- line1 line2 line3 12
- (activate-tonality (harmonic-minor c 4))
- '((16 3))
- '((1 2 5 6 10 11)) ; ok too '((1 2 5 6 9 10 11)) ; '((1 2 5 6 8 9 10 11)) ;
- '(0 5 7)))
-
- (setq hmat1 (filter-deactivate 8 55 (find-change (car new-mater))))
- (setq hmat2 (filter-deactivate 8 55 (find-change (cadr new-mater))))
- (setq hmat3 (filter-deactivate 8 55 (find-change (caddr new-mater))))
-
- (def-instrument-symbol
- lh (symbol-melodize-skip hmat1)
- rh (symbol-shift 1 (symbol-melodize-skip hmat2))
- mh (symbol-shift 1 (symbol-melodize-skip hmat3))
- )
-
- ;; 1/16 can be at the same time or like here
-
- (def-instrument-length
- lh (get-timing '1/8 hmat1)
- rh (get-timing '1/8 hmat2)
- mh (get-timing '1/8 hmat3)
- )
-
- (def-instrument-zone
- lh (make-zone (get-timing '1/8 hmat1))
- rh (make-zone (get-timing '1/8 hmat2))
- mh (make-zone (get-timing '1/8 hmat3))
- )
-
- (def-instrument-tonality
- lh (activate-tonality (harmonic-minor c 4))
- rh (activate-tonality (harmonic-minor c 4))
- mh (activate-tonality (harmonic-minor c 4))
- )
-
- (def-instrument-velocity
- lh (symbol-to-velocity 50 127 3 (symbol-repeat 4 theme))
- rh (symbol-to-velocity 50 127 3 (reverse (symbol-repeat 4 theme)))
- mh (symbol-to-velocity 50 127 3 (reverse (symbol-repeat 4 theme)))
- )
-
- (def-instrument-channel
- lh 1
- rh 2
- mh 3
- )
-
- (compile-instrument-p "ccl;output:" "fugue"
- lh
- rh
- mh
- )
-
-